'*
'*        Stern Pinball (1977) - EM Version
'*        Table scripted by Loserman76
'*        
'*
'*

'DOF Solenoid Config by Outhere
'101 Left Flipper
'102 Right Flipper
'103 Left Slingshot
'104 Right Slingshot
'105 
'106 
'107 Bumper Left
'108 Bumper Right
'109 Bumper Center
'110 
'111 
'112 Beacon (Spinner)
'113 Kicker Right Side (sub sw12_timer)
'114 Kicker Top (sub sw14_timer)
'115 
'116 
'117 
'118 
'119 
'120 BallRelease
'121 
'122 
'123 
'124 
'125 
'126 
'128 
'129 
'230 Knocker
'234 Chime
'235 Chime
'236 Chime


option explicit
Randomize
ExecuteGlobal GetTextFile("core.vbs")

On Error Resume Next
ExecuteGlobal GetTextFile("Controller.vbs")
If Err Then MsgBox "Unable to open Controller.vbs. Ensure that it is in the scripts folder."
On Error Goto 0

Const cGameName = "PinballEM_1977"
Const HSFileName="PinballEM_77VPX.txt"

' Thalamus 2019 July : Improved directional sounds
' !! NOTE : Table not verified yet !!

' Options
' Volume devided by - lower gets higher sound

Const VolDiv = 3000    ' Lower number, louder ballrolling/collition sound
Const VolCol = 10      ' Ball collition divider ( voldiv/volcol )

Const UseLamps=0,UseGI=0,SCoin="coin"
  

LoadEM
Dim DesktopMode: DesktopMode = Table1.ShowDT
Dim InProgress

If DesktopMode = True Then 'Show Desktop components

Ramp16.visible=1
Ramp15.visible=1
Primitive13.visible=1
Else

Ramp16.visible=0
Ramp15.visible=0
Primitive13.visible=0
End if




'FLIPPER 
'*****************************************




'CHECKED
'******************************************************
'			STEPS 2-4 (FLIPPER POLARITY SETUP
'******************************************************

dim LF : Set LF = New FlipperPolarity
dim RF : Set RF = New FlipperPolarity

InitPolarity

Sub InitPolarity()
	dim x, a : a = Array(LF, RF)
	for each x in a
		'safety coefficient (diminishes polarity correction only)
		x.AddPoint "Ycoef", 0, RightFlipper.Y-65, 1	'disabled
		x.AddPoint "Ycoef", 1, RightFlipper.Y-11, 1

		x.enabled = True
		x.TimeDelay = 44
	Next

	
	'rf.report "Polarity"
	AddPt "Polarity", 0, 0, -2.7
	AddPt "Polarity", 1, 0.16, -2.7	
	AddPt "Polarity", 2, 0.33, -2.7
	AddPt "Polarity", 3, 0.37, -2.7	'4.2
	AddPt "Polarity", 4, 0.41, -2.7
	AddPt "Polarity", 5, 0.45, -2.7 '4.2
	AddPt "Polarity", 6, 0.576,-2.7
	AddPt "Polarity", 7, 0.66, -1.8'-2.1896
	AddPt "Polarity", 8, 0.743, -0.5
	AddPt "Polarity", 9, 0.81, -0.5
	AddPt "Polarity", 10, 0.88, 0

	'"Velocity" Profile
	addpt "Velocity", 0, 0, 	1
	addpt "Velocity", 1, 0.16, 1.06
	addpt "Velocity", 2, 0.41, 	1.05
	addpt "Velocity", 3, 0.53, 	1'0.982
	addpt "Velocity", 4, 0.702, 0.968
	addpt "Velocity", 5, 0.95,  0.968
	addpt "Velocity", 6, 1.03, 	0.945

	LF.Object = LeftFlipper	
	LF.EndPoint = EndPointLp	'you can use just a coordinate, or an object with a .x property. Using a couple of simple primitive objects
	RF.Object = RightFlipper
	RF.EndPoint = EndPointRp

End Sub

'Trigger Hit - .AddBall activeball
'Trigger UnHit - .PolarityCorrect activeball

Sub TriggerLF_Hit() : LF.Addball activeball : End Sub
Sub TriggerLF_UnHit() : LF.PolarityCorrect activeball : End Sub
Sub TriggerRF_Hit() : RF.Addball activeball : End Sub
Sub TriggerRF_UnHit() : RF.PolarityCorrect activeball : End Sub

'CHECKED
'**********************************************************************************************************
RightFlipper.timerinterval=1
rightflipper.timerenabled=True

sub RightFlipper_timer()

	If leftflipper.currentangle = leftflipper.endangle and LFPress = 1 then 
		leftflipper.eostorqueangle = EOSAnew
		leftflipper.eostorque = EOSTnew
		LeftFlipper.rampup = EOSRampup
		if LFCount < LiveCatch Then
			LFCount = LFCount + 1
			leftflipper.Elasticity = 0.1
			If LeftFlipper.endangle <> LFEndAngle Then leftflipper.endangle = LFEndAngle
		Else	
			leftflipper.Elasticity = FElasticity
		end if
	elseif leftflipper.currentangle > leftflipper.startangle - 0.05  Then
		leftflipper.rampup = SOSRampup
		leftflipper.endangle = LFEndAngle - 3
		leftflipper.Elasticity = FElasticity
		LFCount = 0
	elseif leftflipper.currentangle > leftflipper.endangle + 0.01 Then 
		leftflipper.eostorque = EOST
		leftflipper.eostorqueangle = EOSA
		LeftFlipper.rampup = Frampup
		leftflipper.Elasticity = FElasticity
	end if

	If rightflipper.currentangle = rightflipper.endangle and RFPress = 1 then
		rightflipper.eostorqueangle = EOSAnew
		rightflipper.eostorque = EOSTnew
		RightFlipper.rampup = EOSRampup
		if RFCount < LiveCatch Then
			RFCount = RFCount + 1
			rightflipper.Elasticity = 0.1
			If RightFlipper.endangle <> RFEndAngle Then rightflipper.endangle = RFEndAngle
		Else
			rightflipper.Elasticity = FElasticity
		end if
	elseif rightflipper.currentangle < rightflipper.startangle + 0.05 Then
		rightflipper.rampup = SOSRampup 
		rightflipper.endangle = RFEndAngle + 3
		rightflipper.Elasticity = FElasticity
		RFCount = 0 
	elseif rightflipper.currentangle < rightflipper.endangle - 0.01 Then 
		rightflipper.eostorque = EOST
		rightflipper.eostorqueangle = EOSA
		RightFlipper.rampup = Frampup
		rightflipper.Elasticity = FElasticity
	end if

end sub

dim LFPress, RFPress, EOST, EOSA, EOSTnew, EOSAnew
dim FStrength, Frampup, FElasticity, EOSRampup, SOSRampup
dim RFEndAngle, LFEndAngle, LFCount, RFCount, LiveCatch

EOST = leftflipper.eostorque
EOSA = leftflipper.eostorqueangle
FStrength = LeftFlipper.strength
Frampup = LeftFlipper.rampup
FElasticity = LeftFlipper.elasticity
EOSTnew = 1.0 'FEOST
EOSAnew = 0.2
EOSRampup = 1.5 
SOSRampup = 8.5 
LiveCatch = 12

LFEndAngle = Leftflipper.endangle
RFEndAngle = RightFlipper.endangle

'CHECKED
'******************************************************
'		FLIPPER CORRECTION SUPPORTING FUNCTIONS
'******************************************************

Sub AddPt(aStr, idx, aX, aY)	'debugger wrapper for adjusting flipper script in-game
	dim a : a = Array(LF, RF)
	dim x : for each x in a
		x.addpoint aStr, idx, aX, aY
	Next
End Sub

'Methods:
'.TimeDelay - Delay before trigger shuts off automatically. Default = 80 (ms)
'.AddPoint - "Polarity", "Velocity", "Ycoef" coordinate points. Use one of these 3 strings, keep coordinates sequential. x = %position on the flipper, y = output
'.Object - set to flipper reference. Optional.
'.StartPoint - set start point coord. Unnecessary, if .object is used.

'Called with flipper - 
'ProcessBalls - catches ball data. 
' - OR - 
'.Fire - fires flipper.rotatetoend automatically + processballs. Requires .Object to be set to the flipper.

Class FlipperPolarity
	Public DebugOn, Enabled
	Private FlipAt	'Timer variable (IE 'flip at 723,530ms...)
	Public TimeDelay	'delay before trigger turns off and polarity is disabled TODO set time!
	private Flipper, FlipperStart, FlipperEnd, LR, PartialFlipCoef
	Private Balls(20), balldata(20)
	
	dim PolarityIn, PolarityOut
	dim VelocityIn, VelocityOut
	dim YcoefIn, YcoefOut
	Public Sub Class_Initialize 
		redim PolarityIn(0) : redim PolarityOut(0) : redim VelocityIn(0) : redim VelocityOut(0) : redim YcoefIn(0) : redim YcoefOut(0)
		Enabled = True : TimeDelay = 50 : LR = 1:  dim x : for x = 0 to uBound(balls) : balls(x) = Empty : set Balldata(x) = new SpoofBall : next 
	End Sub
	
	Public Property let Object(aInput) : Set Flipper = aInput : StartPoint = Flipper.x : End Property
	Public Property Let StartPoint(aInput) : if IsObject(aInput) then FlipperStart = aInput.x else FlipperStart = aInput : end if : End Property
	Public Property Get StartPoint : StartPoint = FlipperStart : End Property
	Public Property Let EndPoint(aInput) : if IsObject(aInput) then FlipperEnd = aInput.x else FlipperEnd = aInput : end if : End Property
	Public Property Get EndPoint : EndPoint = FlipperEnd : End Property
	
	Public Sub AddPoint(aChooseArray, aIDX, aX, aY) 'Index #, X position, (in) y Position (out) 
		Select Case aChooseArray
			case "Polarity" : ShuffleArrays PolarityIn, PolarityOut, 1 : PolarityIn(aIDX) = aX : PolarityOut(aIDX) = aY : ShuffleArrays PolarityIn, PolarityOut, 0
			Case "Velocity" : ShuffleArrays VelocityIn, VelocityOut, 1 :VelocityIn(aIDX) = aX : VelocityOut(aIDX) = aY : ShuffleArrays VelocityIn, VelocityOut, 0
			Case "Ycoef" : ShuffleArrays YcoefIn, YcoefOut, 1 :YcoefIn(aIDX) = aX : YcoefOut(aIDX) = aY : ShuffleArrays YcoefIn, YcoefOut, 0
		End Select
		if gametime > 100 then Report aChooseArray
	End Sub 

	Public Sub Report(aChooseArray) 	'debug, reports all coords in tbPL.text
		if not DebugOn then exit sub
		dim a1, a2 : Select Case aChooseArray
			case "Polarity" : a1 = PolarityIn : a2 = PolarityOut
			Case "Velocity" : a1 = VelocityIn : a2 = VelocityOut
			Case "Ycoef" : a1 = YcoefIn : a2 = YcoefOut 
			case else :tbpl.text = "wrong string" : exit sub
		End Select
		dim str, x : for x = 0 to uBound(a1) : str = str & aChooseArray & " x: " & round(a1(x),4) & ", " & round(a2(x),4) & vbnewline : next
		tbpl.text = str
	End Sub
	
	Public Sub AddBall(aBall) : dim x : for x = 0 to uBound(balls) : if IsEmpty(balls(x)) then set balls(x) = aBall : exit sub :end if : Next  : End Sub

	Private Sub RemoveBall(aBall)
		dim x : for x = 0 to uBound(balls)
			if TypeName(balls(x) ) = "IBall" then 
				if aBall.ID = Balls(x).ID Then
					balls(x) = Empty
					Balldata(x).Reset
				End If
			End If
		Next
	End Sub
	
	Public Sub Fire() 
		Flipper.RotateToEnd
		processballs
	End Sub

	Public Property Get Pos 'returns % position a ball. For debug stuff.
		dim x : for x = 0 to uBound(balls)
			if not IsEmpty(balls(x) ) then
				pos = pSlope(Balls(x).x, FlipperStart, 0, FlipperEnd, 1)
			End If
		Next		
	End Property

	Public Sub ProcessBalls() 'save data of balls in flipper range
		FlipAt = GameTime
		dim x : for x = 0 to uBound(balls)
			if not IsEmpty(balls(x) ) then
				balldata(x).Data = balls(x)
				if DebugOn then StickL.visible = True : StickL.x = balldata(x).x		'debug TODO
			End If
		Next
		PartialFlipCoef = ((Flipper.StartAngle - Flipper.CurrentAngle) / (Flipper.StartAngle - Flipper.EndAngle))
		PartialFlipCoef = abs(PartialFlipCoef-1)
		if abs(Flipper.currentAngle - Flipper.EndAngle) < 30 Then
			PartialFlipCoef = 0
		End If
	End Sub
	Private Function FlipperOn() : if gameTime < FlipAt+TimeDelay then FlipperOn = True : End If : End Function	'Timer shutoff for polaritycorrect
	
	Public Sub PolarityCorrect(aBall)
		if FlipperOn() then 
			dim tmp, BallPos, x, IDX, Ycoef : Ycoef = 1
			dim teststr : teststr = "Cutoff"
			tmp = PSlope(aBall.x, FlipperStart, 0, FlipperEnd, 1)
			if tmp < 0.1 then 'if real ball position is behind flipper, exit Sub to prevent stucks	'Disabled 1.03, I think it's the Mesh that's causing stucks, not this
				if DebugOn then TestStr = "real pos < 0.1 ( " & round(tmp,2) & ")" : tbpl.text = Teststr 
				'RemoveBall aBall
				'Exit Sub
			end if

			'y safety Exit
			if aBall.VelY > -8 then 'ball going down
				if DebugOn then teststr = "y velocity: " & round(aBall.vely, 3) & "exit sub" : tbpl.text = teststr
				RemoveBall aBall
				exit Sub
			end if
			'Find balldata. BallPos = % on Flipper
			for x = 0 to uBound(Balls)
				if aBall.id = BallData(x).id AND not isempty(BallData(x).id) then 
					idx = x
					BallPos = PSlope(BallData(x).x, FlipperStart, 0, FlipperEnd, 1)
					'TB.TEXT = balldata(x).id & " " & BALLDATA(X).X & VBNEWLINE & FLIPPERSTART & " " & FLIPPEREND
					if ballpos > 0.65 then  Ycoef = LinearEnvelope(BallData(x).Y, YcoefIn, YcoefOut)				'find safety coefficient 'ycoef' data
				end if
			Next

			'Velocity correction
			if not IsEmpty(VelocityIn(0) ) then
				Dim VelCoef
				if DebugOn then set tmp = new spoofball : tmp.data = aBall : End If
				if IsEmpty(BallData(idx).id) and aBall.VelY < -12 then 'if tip hit with no collected data, do vel correction anyway
					if PSlope(aBall.x, FlipperStart, 0, FlipperEnd, 1) > 1.1 then 'adjust plz
						VelCoef = LinearEnvelope(5, VelocityIn, VelocityOut)
						if partialflipcoef < 1 then VelCoef = PSlope(partialflipcoef, 0, 1, 1, VelCoef)
						if Enabled then aBall.Velx = aBall.Velx*VelCoef'VelCoef
						if Enabled then aBall.Vely = aBall.Vely*VelCoef'VelCoef
						if DebugOn then teststr = "tip protection" & vbnewline & "velcoef: " & round(velcoef,3) & vbnewline & round(PSlope(aBall.x, FlipperStart, 0, FlipperEnd, 1),3) & vbnewline
						'debug.print teststr
					end if
				Else
		 : 			VelCoef = LinearEnvelope(BallPos, VelocityIn, VelocityOut)
					if Enabled then aBall.Velx = aBall.Velx*VelCoef
					if Enabled then aBall.Vely = aBall.Vely*VelCoef
				end if
			End If

			'Polarity Correction (optional now)
			if not IsEmpty(PolarityIn(0) ) then
				If StartPoint > EndPoint then LR = -1	'Reverse polarity if left flipper
				dim AddX : AddX = LinearEnvelope(BallPos, PolarityIn, PolarityOut) * LR
				if Enabled then aBall.VelX = aBall.VelX + 1 * (AddX*ycoef*PartialFlipcoef)
			End If
			'debug
			if DebugOn then
				TestStr = teststr & "%pos:" & round(BallPos,2)
				if IsEmpty(PolarityOut(0) ) then 
					teststr = teststr & vbnewline & "(Polarity Disabled)" & vbnewline
				else 
					teststr = teststr & "+" & round(1 *(AddX*ycoef*PartialFlipcoef),3)
					if BallPos >= PolarityOut(uBound(PolarityOut) ) then teststr = teststr & "(MAX)" & vbnewline else teststr = teststr & vbnewline end if	
					if Ycoef < 1 then teststr = teststr &  "ycoef: " & ycoef & vbnewline
					if PartialFlipcoef < 1 then teststr = teststr & "PartialFlipcoef: " & round(PartialFlipcoef,4) & vbnewline				
				end if

				teststr = teststr & vbnewline & "Vel: " & round(BallSpeed(tmp),2) & " -> " & round(ballspeed(aBall),2) & vbnewline
				teststr = teststr & "%" & round(ballspeed(aBall) / BallSpeed(tmp),2)
				tbpl.text = TestSTR
			end if
		Else
			'if DebugOn then tbpl.text = "td" & timedelay
		End If
		RemoveBall aBall
	End Sub
End Class

'================================
'Helper Functions


Sub ShuffleArray(ByRef aArray, byVal offset) 'shuffle 1d array
	dim x, aCount : aCount = 0
	redim a(uBound(aArray) )
	for x = 0 to uBound(aArray)	'Shuffle objects in a temp array
		if not IsEmpty(aArray(x) ) Then
			if IsObject(aArray(x)) then 
				Set a(aCount) = aArray(x)
			Else
				a(aCount) = aArray(x)
			End If
			aCount = aCount + 1
		End If
	Next
	if offset < 0 then offset = 0
	redim aArray(aCount-1+offset)	'Resize original array
	for x = 0 to aCount-1		'set objects back into original array
		if IsObject(a(x)) then 
			Set aArray(x) = a(x)
		Else
			aArray(x) = a(x)
		End If
	Next
End Sub

Sub ShuffleArrays(aArray1, aArray2, offset)
	ShuffleArray aArray1, offset
	ShuffleArray aArray2, offset
End Sub


Function BallSpeed(ball) 'Calculates the ball speed
    BallSpeed = SQR(ball.VelX^2 + ball.VelY^2 + ball.VelZ^2)
End Function

Function PSlope(Input, X1, Y1, X2, Y2)	'Set up line via two points, no clamping. Input X, output Y
	dim x, y, b, m : x = input : m = (Y2 - Y1) / (X2 - X1) : b = Y2 - m*X2
	Y = M*x+b
	PSlope = Y
End Function

Function NullFunctionZ(aEnabled):End Function	'1 argument null function placeholder	 TODO move me or replac eme

Class spoofball 
	Public X, Y, Z, VelX, VelY, VelZ, ID, Mass, Radius 
	Public Property Let Data(aBall)
		With aBall
			x = .x : y = .y : z = .z : velx = .velx : vely = .vely : velz = .velz
			id = .ID : mass = .mass : radius = .radius
		end with
	End Property
	Public Sub Reset()
		x = Empty : y = Empty : z = Empty  : velx = Empty : vely = Empty : velz = Empty 
		id = Empty : mass = Empty : radius = Empty
	End Sub
End Class


Function LinearEnvelope(xInput, xKeyFrame, yLvl)
	dim y 'Y output
	dim L 'Line
	dim ii : for ii = 1 to uBound(xKeyFrame)	'find active line
		if xInput <= xKeyFrame(ii) then L = ii : exit for : end if
	Next
	if xInput > xKeyFrame(uBound(xKeyFrame) ) then L = uBound(xKeyFrame)	'catch line overrun
	Y = pSlope(xInput, xKeyFrame(L-1), yLvl(L-1), xKeyFrame(L), yLvl(L) )

	'Clamp if on the boundry lines
	'if L=1 and Y < yLvl(LBound(yLvl) ) then Y = yLvl(lBound(yLvl) )
	'if L=uBound(xKeyFrame) and Y > yLvl(uBound(yLvl) ) then Y = yLvl(uBound(yLvl) )
	'clamp 2.0
	if xInput <= xKeyFrame(lBound(xKeyFrame) ) then Y = yLvl(lBound(xKeyFrame) ) 	'Clamp lower
	if xInput >= xKeyFrame(uBound(xKeyFrame) ) then Y = yLvl(uBound(xKeyFrame) )	'Clamp upper

	LinearEnvelope = Y
End Function

'*****************************************
'FLIPPER SHADOWS
'*****************************************

sub FlipperTimer_Timer()
  FlipperLSh.RotZ = LeftFlipper.currentangle
  FlipperRSh.RotZ = RightFlipper.currentangle

End Sub

Sub ResetDropsTimer_timer
	ResetDropsTimer.enabled=false
	ResetDropTargets
end sub

'Primitive Droptarget Reset
Sub ResetDropTargets
		
		dtBank.DropSol_On 'Drop Target Wall reset 
		PrimDropTgtUp dtBank, 1, 25, 0, 1
		PrimDropTgtUp dtBank, 2, 26, 0, 0
		PrimDropTgtUp dtBank, 3, 27, 0, 0
		PrimDropTgtUp dtBank, 4, 28, 0, 0
		PrimDropTgtUp dtBank, 5, 29, 0, 0
		debug.print SoundFXDOF("dtDrop",111,DOFPulse,DOFContactors)
		DropTargetCounter=0
End Sub

Sub ResetDropsTimer2_timer
	ResetDropsTimer2.enabled=false
	AddScore 10000
	ResetDropsTimer.enabled=true
end sub

'**********************************************************************************************************

'Solenoid Controlled toys
'**********************************************************************************************************

'*****GI Lights On
dim xx
For each xx in GI:xx.State = 1: Next
'**********************************************************************************************************

'Initiate Table
'**********************************************************************************************************
Dim bsTrough, dtBank, bsSaucer, bsSaucer1, kickstep1
dim ScoreChecker
dim CheckAllScores,CheckAllPoints
dim sortscores(5)
dim sortpoints(5)
dim sortplayerpoints(5)
dim sortplayers(5)
Dim Score(4)
Dim ScoreDisplay(4)
Dim HighScorePaid(4)
Dim BonusMultiplier
Dim Credits
Dim Match
Dim Replay1
Dim Replay2
Dim Replay3
Dim Replay4
Dim Replay1Paid(4)
Dim Replay2Paid(4)
Dim Replay3Paid(4)
Dim Replay4Paid(4)
dim obj, rst, i, textstr
Dim TableTilted
Dim TiltCount
Dim BonusCounter
Dim Player
Dim Players
Dim ScoreMotorStepper
Dim SpinnerCounter
Dim DropTargetCounter, ImpulseReelCount
Dim ExtraBallLightFlag, SpecialLitFlag,AlternatingRelay
Dim BallInPlay,BallsPerGame
Dim LastChime10,LastChime100,LastChime1000

Sub Table1_Init
    LoadEM
	If Table1.ShowDT = False then
		for each obj in DesktopCrap
			obj.visible=false
		next
	end if

	OperatorMenuBackdrop.image = "PostitBL"
	For XOpt = 1 to MaxOption
		Eval("OperatorOption"&XOpt).image = "PostitBL"
	next
		
	For XOpt = 1 to 256
		Eval("Option"&XOpt).image = "PostItBL"
	next

	InProgress=false
	MotorRunning=0
	Credits=0
	SpinnerCounter=0
	BallsPerGame=3
	ReplayLevel=1
	TableTilted=false
	loadhs
	If B2SOn then
		Controller.B2SSetTilt 1
		Controller.B2SSetGameOver 1
		Controller.B2SSetCredits Credits
	end if
	MatchReel.SetValue(1)
	GameOverReel.SetValue(1)
	TiltReel.setvalue(1)
	
	If Table1.ShowDT = True then
		For each obj in PlayerScores
			obj.visible=true
		next
		For each obj in PlayerScoresOn
			obj.visible=false
		next
		For each obj in PlayerHUDScores
			obj.state=0
		next
	end if
	RefreshReplayCard
	Set bsTrough = New cvpmBallStack ' Trough handler
		bsTrough.InitSw 0,8,0,0,0,0,0,0
		bsTrough.InitKick Ballrelease, 90, 5
		bsTrough.InitExitSnd SoundFX("ballrelease", DOFContactors), SoundFX("Solenoid",DOFContactors)
		bsTrough.Balls = 1

	'Drop Targets
	Set dtBank = new cvpmDropTarget
		dtBank.InitDrop Array(Sw25, Sw26, Sw27, Sw28, Sw29), Array(25,26,27,28,29)
		dtBank.InitSnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)

	Set bsSaucer=New cvpmBallStack
        bsSaucer.InitSaucer SW12,12,177,18
        bsSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
        bsSaucer.KickAngleVar=10
	
	Set bsSaucer1=New cvpmBallStack
        bsSaucer1.InitSaucer SW13,13,135,18
        bsSaucer1.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
        bsSaucer1.KickAngleVar=10
		
End Sub

Sub Table1_exit()
	savehs

	If B2SOn Then Controller.Stop
end sub
'**********************************************************************************************************
'Plunger code
'**********************************************************************************************************

Sub Table1_KeyDown(ByVal KeyCode)

	' GNMOD
	if EnteringInitials then
		CollectInitials(keycode)
		exit sub
	end if


	if EnteringOptions then
		CollectOptions(keycode)
		exit sub
	end if


	If keycode = PlungerKey Then Plunger.Pullback:playsoundAtVol"plungerpull", Plunger, 1: PlungerPulled = 1

	if keycode = LeftFlipperKey and InProgress = false then
		OperatorMenuTimer.Enabled = true
	end if
	' END GNMOD

	If keycode = LeftTiltKey Then
		Nudge 90, 2
		TiltIt
	End If
    
	If keycode = RightTiltKey Then
		Nudge 270, 2
		TiltIt
	End If
    
	If keycode = CenterTiltKey Then
		Nudge 0, 2
		TiltIt
	End If

	If keycode = MechanicalTilt Then
		TiltCount=2
		TiltIt
	End If

	If keycode = AddCreditKey or keycode = 4 then

		playsound "coinin"
		AddSpecial2
		
	end if

   if keycode = 5 then 
		playsound "coinin"
		AddSpecial2
		keycode= StartGameKey
		
	end if

   if keycode = StartGameKey and Credits>0 and InProgress=true and Players>0 and Players<4 and BallInPlay<2 then
		Credits=Credits-1
		If Credits < 1 Then
			DOF 127, 0

		end if
		CreditsReel.SetValue(Credits)
		Players=Players+1

		Select Case Players
			case 1:
				CanPlay1.state=1
			case 2:
				CanPlay1.state=0
				CanPlay2.state=1
			case 3:
				CanPlay2.state=0
				CanPlay3.state=1
			case 4:
				CanPlay3.state=0
				CanPlay4.state=1
		end select
		playsound "BallyStartButtonPlayers2-4"
		If B2SOn Then
			Controller.B2SSetCanPlay Players
			If Players=2 Then
				Controller.B2SSetScoreRolloverPlayer2 0
			End If
			If Players=3 Then
				Controller.B2SSetScoreRolloverPlayer3 0
			End If
			If Players=4 Then
				Controller.B2SSetScoreRolloverPlayer4 0
			End If
			Controller.B2SSetCredits Credits
		End If
    end if

	if keycode=StartGameKey and Credits>0 and InProgress=false and Players=0 and EnteringOptions = 0 then
'GNMOD
		OperatorMenuTimer.Enabled = false
'END GNMOD
		Credits=Credits-1
		If Credits < 1 Then DOF 232, 0
		CreditsReel.SetValue(Credits)
		Players=1

		CanPlay1.state=1
		MatchReel.SetValue(0)
		Player=1
		playsound "startup_norm"
		rst=0
		BallInPlay=1
		InProgress=true
		GameOverReel.setvalue(0)
		resettimer.enabled=true

		BonusMultiplier=1
		If B2SOn Then
			Controller.B2SSetTilt 0
			Controller.B2SSetGameOver 0
			Controller.B2SSetMatch 0
			Controller.B2SSetCredits Credits
			'Controller.B2SSetScore 4,HighScore
			Controller.B2SSetCanPlay 1
			Controller.B2SSetPlayerUp 1
'			Controller.B2SSetBallInPlay BallInPlay
			Controller.B2SSetScoreRolloverPlayer1 0
		End If
		For each obj in PlayerScores
'			obj.ResetToZero
		next

		If Table1.ShowDT = True then
			For each obj in PlayerScores
'				obj.ResetToZero
				obj.Visible=true
			next
			For each obj in PlayerScoresOn
'				obj.ResetToZero
				obj.Visible=false
			next


			For each obj in PlayerHUDScores
				obj.state=0
			next

			PlayerHUDScores(Player-1).state=1
			PlayerScores(Player-1).Visible=0
			PlayerScoresOn(Player-1).Visible=1


		end If

	end if


	If InProgress=false then exit sub
	If keycode = LeftFlipperKey Then PlaySoundAtVol SoundFXDOF("fx_Flipperup", 101, DOFOn, DOFFlippers),LeftFlipper, 1: LF.fire'LeftFlipper.RotateToEnd: LFPress = 1
	If keycode = RightFlipperKey Then PlaySoundAtVol SoundFXDOF("fx_Flipperup", 102, DOFOn, DOFFlippers),RightFlipper, 1: RF.fire'RightFlipper.RotateToEnd: rfpress = 1



End Sub

Sub Table1_KeyUp(ByVal KeyCode)
	If keycode = PlungerKey Then 
		if PlungerPulled = 0 then
			exit sub
		end if
		Plunger.Fire
		PlaySoundAtVol"plunger", Plunger, 1

	end if
	if keycode = LeftFlipperKey then
		OperatorMenuTimer.Enabled = false
	end if

	' END GNMOD  
	
	If InProgress=false then exit sub
	If keycode = LeftFlipperKey Then
		PlaySoundAtVol SoundFXDOF("fx_Flipperdown", 101, DOFOff, DOFFlippers),LeftFlipper,.1
		LeftFlipper.RotateToStart
		lfpress = 0
		leftflipper.eostorqueangle = EOSA
		leftflipper.eostorque = EOST
	End If
	If keycode = RightFlipperKey Then 
		PlaySoundAtVol SoundFXDOF("fx_Flipperdown", 102, DOFOff, DOFFlippers),RightFlipper,.1
		RightFlipper.RotateToStart
		rfpress = 0
		rightflipper.eostorqueangle = EOSA
		rightflipper.eostorque = EOST
	End If
End Sub

'**********************************************************************************************************

 ' Drain hole and kickers
Sub Drain_Hit

	Drain.DestroyBall
	playsoundAtVol"drain" , Drain, 1
	PauseForBonus.enabled=true

End Sub
Sub sw12_Hit:playsoundAtVol SoundFX("popper_ball", DOFContactors), ActiveBall, 1: ScoreKickerLight: sw12.timerenabled=true: End Sub

sub sw12_timer
	if MotorRunning=1 then exit sub
	sw12.timerenabled=false
	sw12.kick 180,12
    DOF 113, DOFPulse
end sub
	
Sub sw13_Hit

	playsoundAtVol SoundFX("popper_ball", DOFContactors), ActiveBall, 1
	SetMotor 5000
	If L28.state=1 then L60.state=1: L44.state=0
	sw13.timerenabled=true
End Sub

sub sw13_timer
	if MotorRunning=1 then exit sub
	sw13.timerenabled=false
	sw13.kick 150,15
    DOF 114, DOFPulse
end sub

'Drop Targets
Sub Sw25_Hit: PrimDropTgtDown dtBank, 1, 25: CheckDropTargets: End Sub
Sub Sw25_Timer: PrimDropTgtMove 25: End Sub
Sub Sw26_Hit: PrimDropTgtDown dtBank, 2, 26: CheckDropTargets: End Sub
Sub Sw26_Timer: PrimDropTgtMove 26: End Sub
Sub Sw27_Hit: PrimDropTgtDown dtBank, 3, 27: CheckDropTargets: End Sub
Sub Sw27_Timer: PrimDropTgtMove 27: End Sub
Sub Sw28_Hit: PrimDropTgtDown dtBank, 4, 28: CheckDropTargets: End Sub
Sub Sw28_Timer: PrimDropTgtMove 28: End Sub
Sub Sw29_Hit: PrimDropTgtDown dtBank, 5, 29: CheckDropTargets: End Sub
Sub Sw29_Timer: PrimDropTgtMove 29: End Sub

Sub CheckDropTargets
	AddScore(1000)
	DropTargetCounter=DropTargetCounter+1
	if DropTargetCounter>4 then
		if L38.state=1 then
			SpecialLitFlag=1
			LightAltRelay
		end if
		If L54.state=1 then
			
			
			L38.state=1
		end if

		ResetDropsTimer2.enabled=true
	end if

end sub
		
'Wire Triggers
Sub SW32_Hit
	if L52.state=1 then
		AddSpecial
	end if
	AdvanceBonus
	playsoundAtVol"rollover" , ActiveBall, 1 

End Sub

Sub SW24_Hit
	SetMotor 5000
	If L20.state=1 then
		L11.state=1
	end if
	playsoundAtVol"rollover" , ActiveBall, 1

End Sub

Sub SW23_Hit
	SetMotor 5000
	If L21.state=1 then
		L11.state=1
	end if
	playsoundAtVol"rollover" , ActiveBall, 1 

End Sub

Sub SW31_Hit
	if L53.state=1 then
		AddSpecial
	end if
	AdvanceBonus
	playsoundAtVol"rollover" , ActiveBall, 1 
End Sub


'Bumpers
Sub Bumper1_Hit
	If L59a.state=1 then
		AddScore 1000
	else
		AddScore 100
	end if
	playsoundAtVol SoundFXDOF("fx_bumper1",107,DOFPulse,DOFContactors), ActiveBall, 1 

End Sub


Sub Bumper2_Hit
	If L59c.state=1 then
		AddScore 1000
	else
		AddScore 100
	end if
	playsoundAtVol SoundFXDOF("fx_bumper1",108,DOFPulse,DOFContactors), ActiveBall, 1 

End Sub


Sub Bumper3_Hit
	If L59b.state=1 then
		AddScore 1000
	else
		AddScore 100
	end if
	playsoundAtVol SoundFXDOF("fx_bumper1",109,DOFPulse,DOFContactors), ActiveBall, 1 

End Sub

'Spinners
Sub sw30_Spin
DOF 112, DOFPulse
	If L12.state=1 then
		AddScore 1000
	else
		AddScore 100
	end if
	playsoundAtVol"fx_spinner", sw30, 1

End Sub

Dim Step1, Step2', Step3, Step4, Step5

' 'Scoring Rubber
Sub sw21a_hit:AddScore 10 : playsoundAtVol"rubber_hit_2" , ActiveBall, 1: End Sub
Sub sw21b_hit:AddScore 10 : playsoundAtVol"rubber_hit_2" , ActiveBall, 1: End Sub
Sub sw21c_Hit:AddScore 10 : playsoundAtVol"rubber_hit_2" , ActiveBall, 1: Step2=1: sr2R.visible=0: sr2R1.visible=1: me.timerenabled=1: End Sub 
Sub sw21d_hit:AddScore 10 : playsoundAtVol"rubber_hit_2" , ActiveBall, 1: End Sub
Sub sw22a_Hit:SetMotor(50) : playsoundAtVol"rubber_hit_2" , ActiveBall, 1: Step1=1: sr1R.visible=0: sr1R1.visible=1: me.timerenabled=1: End Sub 
Sub sw22b_hit:SetMotor(50): playsoundAtVol"rubber_hit_2" , ActiveBall, 1: End Sub


'Scoring rubbers animations

sub sw22a_timer
	select case Step1
		Case 1: sr1R1.visible=0: sr1r.visible=1
		Case 2: sr1R.visible=0: sr1R2.visible=1
		Case 3: sr1R2.visible=0: sr1R.visible=1: me.timerenabled=0
	end Select
	Step1=Step1+1
end sub

sub sw21c_timer
	select case Step2
		Case 1: sr2R1.visible=0: sr2r.visible=1
		Case 2: sr2R.visible=0: sr2R2.visible=1
		Case 3: sr2R2.visible=0: sr2R.visible=1: me.timerenabled=0
	end Select
	Step2=Step2+1
end sub


'**********************************************************************************************************
'Rollover Targets
'**********************************************************************************************************

Sub sw14a_Hit
	sw14ap.z = -1.5
	If L5.state=1 then 
		AdvanceBonus
	else
		AddScore 10
	end if
	playsoundAtVol"rollover", ActiveBall, 1
End Sub

Sub sw14a_UnHit
	sw14ap.z = .5
	
End Sub

Sub sw14b_Hit
	sw14bp.z = -1.5
	If L36.state=1 then 
		AdvanceBonus
	else
		AddScore 10
	end if
	playsoundAtVol"rollover", ActiveBall, 1
End Sub

Sub sw14b_UnHit
	sw14bp.z = .5
	
End Sub

Sub sw14c_Hit
	sw14cp.z = -1.5
	If L58.state=1 then 
		AdvanceBonus
	else
		AddScore 10
	end if
	playsoundAtVol"rollover", ActiveBall, 1
End Sub

Sub sw14c_UnHit
	sw14cp.z = .5
	
End Sub

Sub sw14d_Hit
	sw14dp.z = -1.5
	If L37.state=1 then 
		AdvanceBonus
	else
		AddScore 10
	end if
	playsoundAtVol"rollover", ActiveBall, 1
End Sub

Sub sw14d_UnHit
	sw14dp.z = .5
	
End Sub

'****************************************************************************
'*****
'***** Primitive Animation subroutines					(gtxjoe v1.05)
'*****
'****************************************************************************
Const WallPrefix 		= "Sw" 'Change this based on your naming convention
Const PrimitivePrefix 	= "PrimSw"'Change this based on your naming convention
Const PrimitiveBumperPrefix = "BR" 'Change this based on your naming convention
Dim primCnt(100), primDir(100), primBmprDir(6)


'************************************************************************
'***** Primitive Drop Target Animation
'************************************************************************
'USAGE:  Sub Sw13_Hit: PrimDropTgtDown RBank, 3, 13: End Sub 
'USAGE:  Sub Sw13_Timer: PrimDropTgtMove 13: End Sub
'USAGE:  Sub solRBankReset (enabled): If enabled Then PrimDropTgtUp RBank, 1, 13, 0, 1: PrimDropTgtUp RBank, 2, 12, 0, 0: PrimDropTgtUp RBank, 3, 11, 0, 0: End If: End Sub

Const DropTgtMovementDir = "transz" 
Const DropTgtMovementMax = 47	 
	
Sub PrimDropTgtDown (targetbankname, targetbanknum, swnum)
	PrimDropTgtAnimate swnum, 0
	targetbankname.Hit targetbanknum
End Sub
Sub PrimDropTgtUp  (targetbankname, targetbanknum, swnum, resetvpmtarget, resetvpmbank)
	PrimDropTgtAnimate swnum, 1
	
	If resetvpmtarget = 1 Then targetbankname.UnHit targetbanknum
	If resetvpmbank = 1 Then targetbankname.DropSol_On
End Sub

Sub PrimDropTgtMove (swNum) 'Customize direction as needed
	If primDir(swNum) = 1 Then 'Up
		Select Case primCnt(swNum)
			Case 0: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax * .75
			Case 1: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax * .25
			Case 2,3,4: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & 10
			Case 5: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & 0
			Case else: Execute wallPrefix & swnum & ".TimerEnabled = 0"
		End Select
	Else 'Down
		Select Case primCnt(swNum)
			Case 0: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax * .25
			Case 1: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax * .5
			Case 2: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax * .75
			Case 3: Execute PrimitivePrefix & swnum & "." & DropTgtMovementDir & "=" & -DropTgtMovementMax
			Case else: Execute wallPrefix & swnum & ".TimerEnabled = 0"

		End Select
	End If
	primCnt(swnum) = primCnt(swnum) + 1
End Sub

Sub PrimDropTgtAnimate  (swnum, dir)
	primCnt(swnum) = 0
	primDir(swnum) = dir
	Execute wallPrefix & swnum & ".TimerInterval = 10" 		
	Execute wallPrefix & swnum & ".TimerEnabled = 1" 			
End Sub

'***************************************************
'       JP's VP10 Fading Lamps & Flashers
'       Based on PD's Fading Light System
' SetLamp 0 is Off
' SetLamp 1 is On
' fading for non opacity objects is 4 steps
'***************************************************

Dim LampState(200), FadingLevel(200)
Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)

InitLamps()             ' turn off the lights and flashers and reset them to the default parameters
LampTimer.Interval = 5 'lamp fading speed
LampTimer.Enabled = 1

' Lamp & Flasher Timers

Sub LampTimer_Timer()
    Dim chgLamp, num, chg, ii
    chgLamp = Controller.ChangedLamps
    If Not IsEmpty(chgLamp) Then
        For ii = 0 To UBound(chgLamp)
            LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1)       'keep the real state in an array
            FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
        Next
    End If
    UpdateLamps
End Sub


Sub UpdateLamps()
NfadeL 1, L1     
NfadeL 2, L2     
NfadeL 3, L3   
'NfadeL 4, L4  'not used
NfadeL 5, L5 
'NfadeL 6, L6  'not used
'NfadeL 7, L7 not used
'NfadeL 8, L8 'not used  
NfadeL 9, L9  
NfadeL 10, L10 
NfadeL 11, L11
NfadeL 12, L12
'NfadeL 13, L13  'Backglass Ball in play
'NFadeL 14, L14  'Backglass 1 player
'NfadeL 15, L15  ''EM Reel player 1-2 Backglass player 1 circle UNVERIFIED
'NfadeL 16, L16  'not used
NfadeL 17, L17   
NfadeL 18, L18   
NfadeL 19, L19   
NfadeL 20, L20   
NfadeL 21, L21 
'NfadeL 22, L22 'not used
'NfadeL 23, L23 'not used
'NfadeL 24, L24 'not used
NfadeL 25, L25 
'NfadeL 26, L26 'not used
'NfadeL 27, L27  'Backglass Game Over
NfadeL 28, L28 
'NfadeL 29, L29 'Backglass Highscore to date
'NfadeL 30, L30 'Backglass 2 player 
'NfadeL 31, L31 ''EM Reel player 2-2 Backglass player 2 circle UNVERIFIED
'NfadeL 32, L32 'not used
NfadeL 33, L33   
NfadeL 34, L34   
'NfadeL 35, L35   'not used
NfadeL 36, L36   
NfadeL 37, L37  
NfadeL 38, L38
'NfadeL 39, L39 'not used
'NfadeL 40, L40 'not used
NfadeL 41, L41 
'NfadeL 42, L42 'not used
'NfadeL 43, L43 'not used
NfadeL 44, L44
'NfadeL 45, L45  ''EM Reel Gameover2
'NfadeL 46, L46   'not used
'NfadeL 47, L47  ''EM Reel player 3-2 Backglass player 3 circle UNVERIFIED
'NfadeL 48, L48 'not used
NfadeL 49, L49   
NfadeL 50, L50   
'NfadeL 51, L51  'not used
NfadeL 52, L52 
NfadeL 53, L53
NfadeL 54, L54 
'NfadeL 55, L55 'not used
'NfadeL 56, L56 'not used
NfadeL 57, L57 
NfadeL 58, L58
NfadeLm 59, L59a 
NfadeLm 59, L59b
NfadeL 59, L59c
NfadeL 60, L60 
NfadeL 60, L60  
'NfadeL 61, L61  'Backglass Tilt
'NfadeL 62, L62 'not used
'NfadeL 63, L63  ''EM Reel player 4-2 Backglass player 4 circle UNVERIFIED
'NfadeL 64, L64 'not used
'NfadeL 65, L65 'not used


End Sub

' div lamp subs

Sub InitLamps()
    Dim x
    For x = 0 to 200
        LampState(x) = 0        ' current light state, independent of the fading level. 0 is off and 1 is on
        FadingLevel(x) = 4      ' used to track the fading state
        FlashSpeedUp(x) = 0.4   ' faster speed when turning on the flasher
        FlashSpeedDown(x) = 0.2 ' slower speed when turning off the flasher
        FlashMax(x) = 1         ' the maximum value when on, usually 1
        FlashMin(x) = 0         ' the minimum value when off, usually 0
        FlashLevel(x) = 0       ' the intensity of the flashers, usually from 0 to 1
    Next
End Sub

Sub AllLampsOff
    Dim x
    For x = 0 to 200
        SetLamp x, 0
    Next
End Sub

Sub SetLamp(nr, value)
    If value <> LampState(nr) Then
        LampState(nr) = abs(value)
        FadingLevel(nr) = abs(value) + 4
    End If
End Sub

' Lights: used for VP10 standard lights, the fading is handled by VP itself

Sub NFadeL(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.state = 0:FadingLevel(nr) = 0
        Case 5:object.state = 1:FadingLevel(nr) = 1
    End Select
End Sub

Sub NFadeLm(nr, object) ' used for multiple lights
    Select Case FadingLevel(nr)
        Case 4:object.state = 0
        Case 5:object.state = 1
    End Select
End Sub

'Lights, Ramps & Primitives used as 4 step fading lights
'a,b,c,d are the images used from on to off

Sub FadeObj(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 6                   'fading to off...
        Case 5:object.image = a:FadingLevel(nr) = 1                   'ON
        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1             'wait
        Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1         'wait
        Case 13:object.image = d:FadingLevel(nr) = 0                  'Off
    End Select
End Sub

Sub FadeObjm(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
        Case 9:object.image = c
        Case 13:object.image = d
    End Select
End Sub

Sub NFadeObj(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 0 'off
        Case 5:object.image = a:FadingLevel(nr) = 1 'on
    End Select
End Sub

Sub NFadeObjm(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
    End Select
End Sub

' Flasher objects

Sub Flash(nr, object)
    Select Case FadingLevel(nr)
        Case 4 'off
            FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
            If FlashLevel(nr) < FlashMin(nr) Then
                FlashLevel(nr) = FlashMin(nr)
                FadingLevel(nr) = 0 'completely off
            End if
            Object.IntensityScale = FlashLevel(nr)
        Case 5 ' on
            FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
            If FlashLevel(nr) > FlashMax(nr) Then
                FlashLevel(nr) = FlashMax(nr)
                FadingLevel(nr) = 1 'completely on
            End if
            Object.IntensityScale = FlashLevel(nr)
    End Select
End Sub

Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
    Object.IntensityScale = FlashLevel(nr)
End Sub

 'Reels
Sub FadeReel(nr, reel)
    Select Case FadingLevel(nr)
        Case 2:FadingLevel(nr) = 0
        Case 3:FadingLevel(nr) = 2
        Case 4:reel.Visible = 0:FadingLevel(nr) = 3
        Case 5:reel.Visible = 1:FadingLevel(nr) = 1
    End Select
End Sub

 'Inverted Reels
Sub FadeIReel(nr, reel)
    Select Case FadingLevel(nr)
        Case 2:FadingLevel(nr) = 0
        Case 3:FadingLevel(nr) = 2
        Case 4:reel.Visible = 1:FadingLevel(nr) = 3
        Case 5:reel.Visible = 0:FadingLevel(nr) = 1
    End Select
End Sub

'**********Sling Shot Animations
' Rstep and Lstep  are the variables that increment the animation
'****************
Dim RStep, Lstep

Sub RightSlingShot_Slingshot

    PlaySoundAtVol SoundFXDOF("right_slingshot", 104, DOFPulse,DOFContactors), sling1, 1
    RSling.Visible = 0
    RSling1.Visible = 1
    sling1.TransZ = -20
    RStep = 0
    RightSlingShot.TimerEnabled = 1
	AddScore 10
End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10
        Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:
    End Select
    RStep = RStep + 1
End Sub

Sub LeftSlingShot_Slingshot

    PlaySoundAtVol SoundFXDOF("left_slingshot", 103, DOFPulse,DOFContactors), sling2, 1
    LSling.Visible = 0
    LSling1.Visible = 1
    sling2.TransZ = -20
    LStep = 0
    LeftSlingShot.TimerEnabled = 1
	AddScore 10
End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10
        Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:
    End Select
    LStep = LStep + 1
End Sub


'*****************************************
'	ninuzzu's	BALL SHADOW
'*****************************************
Dim BallShadow
BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)

Sub BallShadowUpdate_timer()
    Dim BOT, b
    BOT = GetBalls
    ' hide shadow of deleted balls
    If UBound(BOT)<(tnob-1) Then
        For b = (UBound(BOT) + 1) to (tnob-1)
            BallShadow(b).visible = 0
        Next
    End If
    ' exit the Sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub
    ' render the shadow for each ball
    For b = 0 to UBound(BOT)
        If BOT(b).X < Table1.Width/2 Then
            BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/20)) + 6
        Else
            BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/20)) - 6
        End If
        ballShadow(b).Y = BOT(b).Y + 12
        If BOT(b).Z > 20 Then
            BallShadow(b).visible = 1
        Else
            BallShadow(b).visible = 0
        End If
    Next
End Sub

' *******************************************************************************************************
' Positional Sound Playback Functions by DJRobX and Rothbauerw
' PlaySoundAtVol sound, 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 1, AudioFade(ActiveBall)
' *******************************************************************************************************

' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position

Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
  PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
End Sub

' Set position as table object (Use object or light but NOT wall) and Vol to 1

Sub PlaySoundAt(soundname, tableobj)
  PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

'Set all as per ball position & speed.

Sub PlaySoundAtBall(soundname)
  PlaySoundAt soundname, ActiveBall
End Sub

'Set position as table object and Vol manually.

Sub PlaySoundAtVol(sound, tableobj, Volume)
  PlaySound sound, 1, Volume, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

'Set all as per ball position & speed, but Vol Multiplier may be used eg; PlaySoundAtBallVol "sound",3

Sub PlaySoundAtBallVol(sound, VolMult)
  PlaySound sound, 0, Vol(ActiveBall) * VolMult, AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 1, AudioFade(ActiveBall)
End Sub

'Set position as bumperX and Vol manually.

Sub PlaySoundAtBumperVol(sound, tableobj, Vol)
  PlaySound sound, 1, Vol, AudioPan(tableobj), 0,0,1, 1, AudioFade(tableobj)
End Sub

Sub PlaySoundAtBOTBallZ(sound, BOT)
    PlaySound sound, 0, ABS(BOT.velz)/17, Pan(BOT), 0, Pitch(BOT), 1, 0, AudioFade(BOT)
End Sub

' play a looping sound at a location with volume
Sub PlayLoopSoundAtVol(sound, tableobj, Vol)
	PlaySound sound, -1, Vol, AudioPan(tableobj), 0, 0, 1, 0, AudioFade(tableobj)
End Sub

'*********************************************************************
'                     Supporting Ball & Sound Functions
'*********************************************************************

Function RndNum(min, max)
    RndNum = Int(Rnd() * (max-min + 1) ) + min ' Sets a random number between min and max
End Function

Function AudioFade(tableobj) ' Fades between front and back of the table (for surround systems or 2x2 speakers, etc), depending on the Y position on the table. "table1" is the name of the table
  Dim tmp
  On Error Resume Next
  tmp = tableobj.y * 2 / table1.height-1
  If tmp > 0 Then
    AudioFade = Csng(tmp ^10)
  Else
    AudioFade = Csng(-((- tmp) ^10) )
  End If
End Function

Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
  Dim tmp
  On Error Resume Next
  tmp = tableobj.x * 2 / table1.width-1
  If tmp > 0 Then
    AudioPan = Csng(tmp ^10)
  Else
    AudioPan = Csng(-((- tmp) ^10) )
  End If
End Function

Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table1" is the name of the table
  Dim tmp
  On Error Resume Next
  tmp = ball.x * 2 / table1.width-1
  If tmp > 0 Then
    Pan = Csng(tmp ^10)
  Else
    Pan = Csng(-((- tmp) ^10) )
  End If
End Function

Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
  Vol = Csng(BallVel(ball) ^2 / VolDiv)
End Function

Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  Pitch = BallVel(ball) * 20
End Function

Function BallVel(ball) 'Calculates the ball speed
  BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
End Function

Function BallVelZ(ball) 'Calculates the ball speed in the -Z
    BallVelZ = INT((ball.VelZ) * -1 )
End Function

Function VolZ(ball) ' Calculates the Volume of the sound based on the ball speed in the Z
    VolZ = Csng(BallVelZ(ball) ^2 / 200)*1.2
End Function

'*** Determines if a Points (px,py) is inside a 4 point polygon A-D in Clockwise/CCW order

Function InRect(px,py,ax,ay,bx,by,cx,cy,dx,dy)
  Dim AB, BC, CD, DA
  AB = (bx*py) - (by*px) - (ax*py) + (ay*px) + (ax*by) - (ay*bx)
  BC = (cx*py) - (cy*px) - (bx*py) + (by*px) + (bx*cy) - (by*cx)
  CD = (dx*py) - (dy*px) - (cx*py) + (cy*px) + (cx*dy) - (cy*dx)
  DA = (ax*py) - (ay*px) - (dx*py) + (dy*px) + (dx*ay) - (dy*ax)

  If (AB <= 0 AND BC <=0 AND CD <= 0 AND DA <= 0) Or (AB >= 0 AND BC >=0 AND CD >= 0 AND DA >= 0) Then
    InRect = True
  Else
    InRect = False
  End If
End Function



'*****************************************
'      JP's VP10 Rolling Sounds
'*****************************************

Const tnob = 5 ' total number of balls
ReDim rolling(tnob)
InitRolling

Sub InitRolling
    Dim i
    For i = 0 to tnob
        rolling(i) = False
    Next
End Sub

Sub RollingTimer_Timer()
    Dim BOT, b
    BOT = GetBalls

	' stop the sound of deleted balls
    For b = UBound(BOT) + 1 to tnob
        rolling(b) = False
        StopSound("fx_ballrolling" & b)
    Next

	' exit the sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub

	' play the rolling sound for each ball
    For b = 0 to UBound(BOT)
      If BallVel(BOT(b) ) > 1 Then
        rolling(b) = True
        if BOT(b).z < 30 Then ' Ball on playfield
          PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), AudioPan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0, AudioFade(BOT(b) )
        Else ' Ball on raised ramp
          PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) )*.5, AudioPan(BOT(b) ), 0, Pitch(BOT(b) )+50000, 1, 0, AudioFade(BOT(b) )
        End If
      Else
        If rolling(b) = True Then
          StopSound("fx_ballrolling" & b)
          rolling(b) = False
        End If
      End If
    If BOT(b).VelZ < -1 and BOT(b).z < 55 and BOT(b).z > 27 Then 'height adjust for ball drop sounds
      PlaySoundAtBOTBallZ "fx_ball_drop" & b, BOT(b)
    End If
    Next
End Sub

'**********************
' Ball Collision Sound
'**********************

Sub OnBallBallCollision(ball1, ball2, velocity)
    PlaySound("fx_collide"), 0, Csng(velocity) ^2 / (VolDiv/VolCol), AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
End Sub

'************************************
' What you need to add to your table
'************************************

' a timer called RollingTimer. With a fast interval, like 10
' one collision sound, in this script is called fx_collide
' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc


'******************************************
' Explanation of the rolling sound routine
'******************************************

' sounds are played based on the ball speed and position

' the routine checks first for deleted balls and stops the rolling sound.

' The For loop goes through all the balls on the table and checks for the ball speed and
' if the ball is on the table (height lower than 30) then then it plays the sound
' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.

' The sound is played using the VOL, PAN and PITCH functions, so the volume and pitch of the sound
' will change according to the ball speed, and the PAN function will change the stereo position according
' to the position of the ball on the table.


'**************************************
' Explanation of the collision routine
'**************************************

' The collision is built in VP.
' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
' will call this routine. What you add in the sub is up to you. As an example is a simple Playsound with volume and paning
' depending of the speed of the collision.


Sub Pins_Hit (idx)
	PlaySound "pinhit_low", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Targets_Hit (idx)
	PlaySound "target", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Thin_Hit (idx)
	PlaySound "metalhit_thin", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Medium_Hit (idx)
	PlaySound "metalhit_medium", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals2_Hit (idx)
	PlaySound "metalhit2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Gates_Hit (idx)
	PlaySound "gate4", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

' Sub Spinner_Spin
' 	PlaySound "fx_spinner",0,.25,0,0.25
' End Sub

Sub Rubbers_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 20 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 20 then
 		RandomSoundRubber()
 	End If
End Sub

Sub Posts_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 16 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 16 then
 		RandomSoundRubber()
 	End If
End Sub

Sub RandomSoundRubber()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub

Sub LeftFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RightFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RandomSoundFlipper()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub

'****************************************
'  SCORE MOTOR
'****************************************


ScoreMotorTimer.Enabled = 1
ScoreMotorTimer.Interval = 135 '135
AddScoreTimer.Enabled = 1
AddScoreTimer.Interval = 135

Dim queuedscore
Dim MotorMode
Dim MotorPosition
Dim MotorRunning

Sub SetMotor(y)
	If MotorRunning<>1 And InProgress=true then
		queuedscore=queuedscore+y
	end if
end sub

Sub SetMotor2(x)
	If MotorRunning<>1 And InProgress=true then
		MotorRunning=1
		
		Select Case x
			Case 10:
				AddScore(10)
				MotorRunning=0
				
				
			Case 20:
				MotorMode=10
				MotorPosition=2
			Case 30:
				MotorMode=10
				MotorPosition=3
			Case 40:
				MotorMode=10
				MotorPosition=4
			Case 50:
				MotorMode=10
				MotorPosition=5
			Case 100:
				MotorMode=100
				MotorPosition=1
			Case 200:
				MotorMode=100
				MotorPosition=2
			Case 300:
				MotorMode=100
				MotorPosition=3
			Case 400:
				MotorMode=100
				MotorPosition=4
			Case 500:
				MotorMode=100
				MotorPosition=5
			Case 1000:
				AddScore(1000)
				MotorRunning=0
				
			Case 2000:
				MotorMode=1000
				MotorPosition=2
			Case 3000:
				MotorMode=1000
				MotorPosition=3
			Case 4000:
				MotorMode=1000
				MotorPosition=4		
			Case 5000:
				MotorMode=1000
				MotorPosition=5
			Case 10000:
				AddScore(10000)
				MotorRunning=0
				
			Case 20000:
				MotorMode=10000
				MotorPosition=2
			Case 30000:
				MotorMode=10000
				MotorPosition=3
			Case 40000:
				MotorMode=10000
				MotorPosition=4		
			Case 50000:
				MotorMode=10000
				MotorPosition=5
		End Select
	End If
End Sub

Sub AddScoreTimer_Timer
	Dim tempscore
	
	
	If MotorRunning<>1 And InProgress=true then
		if queuedscore>=50000 then
			tempscore=50000
			queuedscore=queuedscore-50000
			SetMotor2(50000)
			exit sub
		end if
		if queuedscore>=40000 then
			tempscore=40000
			queuedscore=queuedscore-40000
			SetMotor2(40000)
			exit sub
		end if
				
		if queuedscore>=30000 then
			tempscore=30000
			queuedscore=queuedscore-30000
			SetMotor2(30000)
			exit sub
		end if
			
		if queuedscore>=20000 then
			tempscore=20000
			queuedscore=queuedscore-20000
			SetMotor2(20000)
			exit sub
		end if
			
		if queuedscore>=10000 then
			tempscore=10000
			queuedscore=queuedscore-10000
			SetMotor2(10000)
			exit sub
		end if
		if queuedscore>=5000 then
			tempscore=5000
			queuedscore=queuedscore-5000
			SetMotor2(5000)
			exit sub
		end if
		if queuedscore>=4000 then
			tempscore=4000
			queuedscore=queuedscore-4000
			SetMotor2(4000)
			exit sub
		end if
				
		if queuedscore>=3000 then
			tempscore=3000
			queuedscore=queuedscore-3000
			SetMotor2(3000)
			exit sub
		end if
			
		if queuedscore>=2000 then
			tempscore=2000
			queuedscore=queuedscore-2000
			SetMotor2(2000)
			exit sub
		end if
			
		if queuedscore>=1000 then
			tempscore=1000
			queuedscore=queuedscore-1000
			SetMotor2(1000)
			exit sub
		end if
			
		if queuedscore>=500 then
			tempscore=500
			queuedscore=queuedscore-500
			SetMotor2(500)
			exit sub
		end if
		if queuedscore>=400 then
			tempscore=400
			queuedscore=queuedscore-400
			SetMotor2(400)
			exit sub
		end if
		if queuedscore>=300 then
			tempscore=300
			queuedscore=queuedscore-300
			SetMotor2(300)
			exit sub
		end if
		if queuedscore>=200 then
			tempscore=200
			queuedscore=queuedscore-200
			SetMotor2(200)
			exit sub
		end if
		if queuedscore>=100 then
			tempscore=100
			queuedscore=queuedscore-100
			SetMotor2(100)
			exit sub
		end if

		if queuedscore>=50 then
			tempscore=50
			queuedscore=queuedscore-50
			SetMotor2(50)
			exit sub
		end if
		if queuedscore>=40 then
			tempscore=40
			queuedscore=queuedscore-40
			SetMotor2(40)
			exit sub
		end if
		if queuedscore>=30 then
			tempscore=30
			queuedscore=queuedscore-30
			SetMotor2(30)
			exit sub
		end if
		if queuedscore>=20 then
			tempscore=20
			queuedscore=queuedscore-20
			SetMotor2(20)
			exit sub
		end if
		if queuedscore>=10 then
			tempscore=10
			queuedscore=queuedscore-10
			SetMotor2(10)
			exit sub
		end if

	End If


end Sub

Sub ScoreMotorTimer_Timer
	If MotorPosition > 0 Then
		Select Case MotorPosition
			Case 5,4,3,2:

				If MotorMode=10000 Then 
					AddScore(10000)
				End if
				If MotorMode=1000 Then 
					AddScore(1000)
				End if
				if MotorMode=100 then
					AddScore(100)
				End If
				if MotorMode=10 then
					AddScore(10)
				End if
				MotorPosition=MotorPosition-1
			Case 1:
				If MotorMode=10000 Then 
					AddScore(10000)
				End if
				If MotorMode=1000 Then 
					AddScore(1000)
				end if
				if MotorMode=100 then
					AddScore(100)
				End If
				if MotorMode=10 then
					AddScore(10)
					
				End if
				MotorPosition=0:MotorRunning=0
		End Select
	End If
End Sub

Sub AddScore(x)
	If TableTilted=true then exit sub
	ImpulseReelCount=ImpulseReelCount+1
	if ImpulseReelCount>4 then
		ImpulseReelCount=0
	end if
	AddScore2(x)
end sub


Sub AddScore2(x)
	Dim OldScore, NewScore, OldTestScore, NewTestScore
    OldScore = Score(Player)

	Select Case x
        Case 1:
            Score(Player)=Score(Player)+1
		Case 10:
			Score(Player)=Score(Player)+10
		Case 100:
			Score(Player)=Score(Player)+100
		Case 1000:
			Score(Player)=Score(Player)+1000
		Case 10000:
			Score(Player)=Score(Player)+10000
	End Select
	NewScore = Score(Player)

	OldTestScore = OldScore
	NewTestScore = NewScore
	Do
		if OldTestScore < Replay1 and NewTestScore >= Replay1 then
			AddSpecial()
			NewTestScore = 0
		Elseif OldTestScore < Replay2 and NewTestScore >= Replay2 then
			AddSpecial()
			NewTestScore = 0
		Elseif OldTestScore < Replay3 and NewTestScore >= Replay3 then
			AddSpecial()
			NewTestScore = 0
		Elseif OldTestScore < Replay4 and NewTestScore >= Replay4 then
			AddSpecial()
			NewTestScore = 0
		End if
		NewTestScore = NewTestScore - 1000000
		OldTestScore = OldTestScore - 1000000
	Loop While NewTestScore > 0

    OldScore = int(OldScore / 10)	' divide by 10 for games with fixed 0 in 1s position, by 1 for games with real 1s digits
    NewScore = int(NewScore / 10)	' divide by 10 for games with fixed 0 in 1s position, by 1 for games with real 1s digits
	' MsgBox("OldScore="&OldScore&", NewScore="&NewScore&", OldScore Mod 10="&OldScore Mod 10 & ", NewScore % 10="&NewScore Mod 10)

    if (OldScore Mod 10 <> NewScore Mod 10) then
		PlayChime(10)
		RotateKickerLight
		AltRelay
	end if
    OldScore = int(OldScore / 10)
    NewScore = int(NewScore / 10)
	' MsgBox("OldScore="&OldScore&", NewScore="&NewScore)
    if (OldScore Mod 10 <> NewScore Mod 10) then
		PlayChime(10)

		
    end if

    OldScore = int(OldScore / 10)
    NewScore = int(NewScore / 10)
	' MsgBox("OldScore="&OldScore&", NewScore="&NewScore)
    if (OldScore Mod 10 <> NewScore Mod 10) then
		PlayChime(100)
		

    end if

    OldScore = int(OldScore / 10)
    NewScore = int(NewScore / 10)
	' MsgBox("OldScore="&OldScore&", NewScore="&NewScore)
    if (OldScore Mod 10 <> NewScore Mod 10) then
		PlayChime(1000)
    end if

	If B2SOn Then
		Controller.B2SSetScorePlayer Player, Score(Player)
	End If
'	EMReel1.SetValue Score(Player)
	PlayerScores(Player-1).AddValue(x)
	PlayerScoresOn(Player-1).AddValue(x)
End Sub



Sub PlayChime(x)


		Select Case x
			Case 10
				If LastChime10=1 Then
					PlaySound SoundFXDOF("10",234,DOFPulse,DOFChimes)
					LastChime10=0
				Else
					PlaySound SoundFXDOF("10",234,DOFPulse,DOFChimes)
					LastChime10=1
				End If
			Case 100
				If LastChime100=1 Then
					PlaySound SoundFXDOF("100",235,DOFPulse,DOFChimes)
					LastChime100=0
				Else
					PlaySound SoundFXDOF("100",235,DOFPulse,DOFChimes)
					LastChime100=1
				End If
			Case 1000
				If LastChime1000=1 Then
					PlaySound SoundFXDOF("1000",236,DOFPulse,DOFChimes)
					LastChime1000=0
				Else
					PlaySound SoundFXDOF("1000",236,DOFPulse,DOFChimes)
					LastChime1000=1
				End If
		End Select
End Sub

'*************************************************
' Additional routines for EM operation
'*************************************************
Sub AddSpecial()
	PlaySound SoundFXDOF("knocker",230,DOFPulse,DOFContactors)
	DOF 231,2
	Credits=Credits+1
	DOF 232,1
	if Credits>15 then Credits=15
	If B2SOn Then
		Controller.B2SSetCredits Credits
	End If
	CreditsReel.SetValue(Credits)
End Sub

Sub AddSpecial2()
	PlaySound"click"
	Credits=Credits+1
	DOF 232,1
	if Credits>15 then Credits=15
	If B2SOn Then
		Controller.B2SSetCredits Credits
	End If
	CreditsReel.SetValue(Credits)
End Sub

Sub PauseForBonus_timer
	PauseForBonus.enabled=false
	ScoreBonus
end sub

Sub NextBallDelay_timer
	NextBallDelay.enabled=false
	NextBall
end sub

sub SetupNextBall
	TableTilted=false
	TiltReel.setvalue(0)
	If B2SOn then
		Controller.B2SSetTilt 0
	end if
	ResetDropTargets
	AdvanceBonus
	L28.state=0
	L12.state=0
	L44.state=0
	L60.state=0
	L11.state=0
	L54.state=1
	L38.state=0
	L52.state=0
	L20.state=0
	L21.state=0
	L53.state=0
	ExtraBallLightFlag=0
	SpecialLitFlag=0
	playsound SoundFXDOF("StartBall1", 120, DOFPulse, DOFContactors)
	BallRelease.CreateSizedBall 25
	BallRelease.Kick 90,5
	BallInPlayReel.setvalue(BallInPlay)
    'DOF 120, DOFPulse

end sub

sub NewGame
	AlternatingRelay=0
	SpinnerCounter=4
	BonusCounter=0
	LightAltRelay
	RotateKickerLight
	BallInPlay=1
	SetupNextBall

end sub

Sub NextBall
	If L11.state=0 then
		Player=Player+1
	end if
	If Player>Players Then
		BallInPlay=BallInPlay+1
		If BallInPlay>BallsPerGame then
			PlaySound("MotorLeer")
			InProgress=false
			
			If B2SOn Then
				Controller.B2SSetGameOver 1
				Controller.B2SSetPlayerUp 0
				Controller.B2SSetBallInPlay 0
				Controller.B2SSetCanPlay 0
			End If

			For each obj in PlayerHUDScores
				obj.state=0
			next
			If Table1.ShowDT = True then
				For each obj in PlayerScores
					obj.visible=1
				Next
				For each obj in PlayerScoresOn
					obj.visible=0
				Next
			end If
			
			BallInPlayReel.SetValue(0)
			GameOverReel.setvalue(1)
			LeftFlipper.RotateToStart
			RightFlipper.RotateToStart


			if TableTilted=false then
				checkmatch
			end if
			CheckHighScore
			Players=0
			HighScoreTimer.interval=100
			HighScoreTimer.enabled=True
		Else
			Player=1
			If B2SOn Then
				Controller.B2SSetPlayerUp Player
				Controller.B2SSetBallInPlay BallInPlay

			End If

			For each obj in PlayerHUDScores
				obj.state=0
			next
			If Table1.ShowDT = True then
				For each obj in PlayerScores
					obj.visible=1
				Next
				For each obj in PlayerScoresOn
					obj.visible=0
				Next

				PlayerHUDScores(Player-1).state=1
				PlayerScores(Player-1).visible=0
				PlayerScoresOn(Player-1).visible=1

			end If

			SetupNextBall
		End If
	Else 
		If B2SOn Then
			Controller.B2SSetPlayerUp Player
			Controller.B2SSetBallInPlay BallInPlay
		End If

		For each obj in PlayerHUDScores
			obj.state=0
		next
		If Table1.ShowDT = True then
			For each obj in PlayerScores
					obj.visible=1
			Next
			For each obj in PlayerScoresOn
					obj.visible=0
			Next
			PlayerHUDScores(Player-1).state=1
			PlayerScores(Player-1).visible=0
			PlayerScoresOn(Player-1).visible=1
		end If
		SetupNextBall
	End If

End sub

sub checkmatch
	Dim tempmatch
	tempmatch=Int(Rnd*10)
	Match=tempmatch
	MatchReel.SetValue(tempmatch+1)


	If B2SOn Then
		If Match = 0 Then
			Controller.B2SSetMatch 100
		Else
			Controller.B2SSetMatch Match*10
		End If
	End if
	Match=Match*10
	for i = 1 to Players
		if Match=(Score(i) mod 100) then
			AddSpecial
		end if
	next
end sub

sub CheckHighScore
	Dim playertops
		dim si
	dim sj
	dim stemp
	dim stempplayers
	for i=1 to 5
		sortscores(i)=0
		sortplayers(i)=0
		sortpoints(i)=0
		sortplayerpoints(i)=0
	next
	playertops=0
	for i = 1 to Players
		sortscores(i)=Score(i)
		sortplayers(i)=i

	next

	ScoreChecker=5
	CheckAllScores=1
	CheckAllPoints=0
	NewHighScore sortscores(ScoreChecker),sortplayers(ScoreChecker)
	savehs
end sub

Sub TiltTimer_Timer()
	if TiltCount > 0 then TiltCount = TiltCount - 1
	if TiltCount = 0 then
		TiltTimer.Enabled = False
	end if
end sub

Sub TiltIt()
		TiltCount = TiltCount + 1
		if TiltCount = 3 then
			TableTilted=True

			LeftFlipper.RotateToStart
			RightFlipper.RotateToStart
			TiltReel.SetValue(1)
			If B2Son then
				Controller.B2SSetTilt 1
			end if
			
		else
			TiltTimer.Interval = 500
			TiltTimer.Enabled = True
		end if
	
end sub


sub AdvanceBonus
	if BonusCounter<10 then
		If BonusCounter<10 then
			Bonus(BonusCounter).state=0
			BonusCounter=BonusCounter+1
			Bonus(BonusCounter).state=1
		elseIf BonusCounter>9 then
			Bonus(BonusCounter-10).state=0
			BonusCounter=BonusCounter+1
			Bonus(10).state=1
			Bonus(BonusCounter-10).state=1	
		end if
	end if
end sub

sub ScoreBonus
	ScoreMotorStepper=0
	CollectBonus.interval=200
	CollectBonus.enabled=1
end sub

sub CollectBonus_timer
	if MotorRunning=1 then
		exit sub
	end if
	if BonusCounter<1 then
		CollectBonus.enabled=0
		NextBallDelay.enabled=true
	else
		If L44.state=1 then
			Select case ScoreMotorStepper
				case 0,1,3,4:
					AddScore(10000)
					
				case 2,5:
					PlaySound"BallyClunk"
					If BonusCounter>10 then
						Bonus(BonusCounter-10).state=0
					else
						Bonus(BonusCounter).state=0
						
					end if

					BonusCounter=BonusCounter-1
					if BonusCounter>=0 then
						If BonusCounter<=10 then
							Bonus(BonusCounter).state=1
						elseif BonusCounter>10 then
							Bonus(10).state=1
							Bonus(BonusCounter-10).state=1
						end if
					end if
				case 6:


				case 7:


			end select
			ScoreMotorStepper=ScoreMotorStepper+1
			If ScoreMotorStepper>7 then
				ScoreMotorStepper=0
			end if
		elseIf L60.state=1 then
			Select case ScoreMotorStepper
				case 0,1,2:
					AddScore(10000)
					
				case 3:
					PlaySound"BallyClunk"
					If BonusCounter>10 then
						Bonus(BonusCounter-10).state=0
					else
						Bonus(BonusCounter).state=0
						
					end if

					BonusCounter=BonusCounter-1
					if BonusCounter>=0 then
						If BonusCounter<=10 then
							Bonus(BonusCounter).state=1
						elseif BonusCounter>10 then
							Bonus(10).state=1
							Bonus(BonusCounter-10).state=1
						end if
					end if
				case 4:


				case 5:


			end select
			ScoreMotorStepper=ScoreMotorStepper+1
			If ScoreMotorStepper>5 then
				ScoreMotorStepper=0
			end if
		
		else
			Select Case ScoreMotorStepper
				case 0,1,2,3,4:
					AddScore(10000)
					If BonusCounter>10 then
						Bonus(BonusCounter-10).state=0
					else
						Bonus(BonusCounter).state=0
						
					end if
					BonusCounter=BonusCounter-1
					if BonusCounter>=0 then
						If BonusCounter<=10 then
							Bonus(BonusCounter).state=1
						elseif BonusCounter>10 then
							Bonus(10).state=1
							Bonus(BonusCounter-10).state=1
						end if
					end if
				case 5:
					PlaySound"BallyClunk"

					
			end select
			ScoreMotorStepper=ScoreMotorStepper+1
			If ScoreMotorStepper>5 then
				ScoreMotorStepper=0
			end if
		end if
	end if
end sub	

sub resettimer_timer
    rst=rst+1
	if rst>1 and rst<12 then
		ResetReelsToZero(1)
	end if  
    if rst=17 then
    playsound "StartBall1"
    end if
    if rst=18 then
    newgame
    resettimer.enabled=false
    end if
end sub

Sub ResetReelsToZero(reelzeroflag)
	dim d1(5)
	dim d2(5)
	dim scorestring1, scorestring2

	If reelzeroflag=1 then
		scorestring1=CStr(Score(1))
		scorestring2=CStr(Score(2))
		scorestring1=right("00000" & scorestring1,5)
		scorestring2=right("00000" & scorestring2,5)
		for i=0 to 4
			d1(i)=CInt(mid(scorestring1,i+1,1))
			d2(i)=CInt(mid(scorestring2,i+1,1))
		next
		for i=0 to 4
			if d1(i)>0 then 
				d1(i)=d1(i)+1
				if d1(i)>9 then d1(i)=0
			end if
			if d2(i)>0 then 
				d2(i)=d2(i)+1
				if d2(i)>9 then d2(i)=0
			end if

		next
		Score(1)=(d1(0)*10000) + (d1(1)*1000) + (d1(2)*100) + (d1(3)*10) + d1(4)
		Score(2)=(d2(0)*10000) + (d2(1)*1000) + (d2(2)*100) + (d2(3)*10) + d2(4)
		If B2SOn Then
			Controller.B2SSetScorePlayer 1, Score(1)
			Controller.B2SSetScorePlayer 2, Score(2)
		End If
		PlayerScores(0).SetValue(Score(1))
		PlayerScoresOn(0).SetValue(Score(1))
		PlayerScores(1).SetValue(Score(2))
		PlayerScoresOn(1).SetValue(Score(2))

		scorestring1=CStr(Score(3))
		scorestring2=CStr(Score(4))
		scorestring1=right("00000" & scorestring1,5)
		scorestring2=right("00000" & scorestring2,5)
		for i=0 to 4
			d1(i)=CInt(mid(scorestring1,i+1,1))
			d2(i)=CInt(mid(scorestring2,i+1,1))
		next
		for i=0 to 4
			if d1(i)>0 then 
				d1(i)=d1(i)+1
				if d1(i)>9 then d1(i)=0
			end if
			if d2(i)>0 then 
				d2(i)=d2(i)+1
				if d2(i)>9 then d2(i)=0
			end if

		next
		Score(3)=(d1(0)*10000) + (d1(1)*1000) + (d1(2)*100) + (d1(3)*10) + d1(4)
		Score(4)=(d2(0)*10000) + (d2(1)*1000) + (d2(2)*100) + (d2(3)*10) + d2(4)
		If B2SOn Then
			Controller.B2SSetScorePlayer 3, Score(3)
			Controller.B2SSetScorePlayer 4, Score(4)
		End If
		PlayerScores(2).SetValue(Score(3))
		PlayerScoresOn(2).SetValue(Score(3))
		PlayerScores(3).SetValue(Score(4))
		PlayerScoresOn(3).SetValue(Score(4))

	end if

end sub

Sub RotateKickerLight
	SpinnerCounter=SpinnerCounter+1
	if SpinnerCounter>4 then SpinnerCounter=0
	for each obj in Kickerlights
		obj.state=0
	next
	KickerLights(SpinnerCounter).state=1
end sub

Sub ScoreKickerLight
	select case SpinnerCounter
		case 0:
			L12.state=1
			SetMotor 5000
		case 1:
			SetMotor(50000)
		case 2:
			If L60.state=0 then
				L44.state=1
			end if
			SetMotor 5000
		case 3:
			ExtraBallLightFlag=1
			LightAltRelay
			SetMotor 5000
		case 4:
			L28.state=1
			SetMotor 5000
	end select
end sub

Sub AltRelay
	if AlternatingRelay=0 then
		AlternatingRelay=1
	else
		AlternatingRelay=0
	end if
	LightAltRelay
end sub

sub LightAltRelay
	If AlternatingRelay=0 then
		L5.state=1
		L36.state=1
		L58.state=1
		L37.state=1
		L59a.state=1
		L59c.state=1
		L59b.state=0
		L21.state=0
		L52.state=0
		If ExtraBallLightFlag=1 then
			L20.state=1
		else
			L20.state=0
		end if
		If SpecialLitFlag=1 then
			L53.state=1
		else
			L53.state=0
		end if
	else
		L5.state=0
		L36.state=0
		L58.state=0
		L37.state=0
		L59a.state=0
		L59c.state=0
		L59b.state=1
		L20.state=0
		L53.state=0
		If ExtraBallLightFlag=1 then
			L21.state=1
		else
			L21.state=0
		end if
		If SpecialLitFlag=1 then
			L52.state=1
		else
			L52.state=0
		end if
	end if
end sub

sub savehs
	' Based on Black's Highscore routines
	Dim FileObj
	Dim ScoreFile
	Set FileObj=CreateObject("Scripting.FileSystemObject")
	If Not FileObj.FolderExists(UserDirectory) then 
		Exit Sub
	End if
	Set ScoreFile=FileObj.CreateTextFile(UserDirectory & HSFileName,True)
		ScoreFile.WriteLine 1
		ScoreFile.WriteLine Credits
		scorefile.writeline BallsPerGame
		ScoreFile.WriteLine ReplayLevel


		for xx=1 to 5
			scorefile.writeline HSScore(xx)
		next
		for xx=1 to 5
			scorefile.writeline HSName(xx)
		next
		for xx=6 to 10
			scorefile.writeline HSScore(xx)
		next
		for xx=6 to 10
			scorefile.writeline HSName(xx)
		next
		ScoreFile.Close
	Set ScoreFile=Nothing
	Set FileObj=Nothing
end sub

sub loadhs
    ' Based on Black's Highscore routines
	Dim FileObj
	Dim ScoreFile
	Dim HighScore
    dim temp1
    dim temp2
	dim temp3
	dim temp4

	dim temp8
	dim temp9
	dim temp10
	dim temp11
	dim temp12
	dim temp13
	dim temp14
	dim temp15
	dim temp16
	dim temp17
	dim temp18
	dim temp19
	dim temp20
	dim temp21
	dim temp22
	dim temp23
	dim temp24
	dim temp25
	dim temp26
	dim temp27

    Set FileObj=CreateObject("Scripting.FileSystemObject")
	If Not FileObj.FolderExists(UserDirectory) then 
		Exit Sub
	End if
	If Not FileObj.FileExists(UserDirectory & HSFileName) then
		Exit Sub
	End if
	Set ScoreFile=FileObj.GetFile(UserDirectory & HSFileName)
	Set TextStr=ScoreFile.OpenAsTextStream(1,0)
		If (TextStr.AtEndOfStream=True) then
			Exit Sub
		End if
		temp1=TextStr.ReadLine
		temp2=textstr.readline
		temp3=textstr.readline
		temp4=textstr.readline

		HighScore=cdbl(temp1)
		if HighScore=1 then
			
			temp8=textstr.readline
			temp9=textstr.readline
			temp10=textstr.readline
			temp11=textstr.readline
			temp12=textstr.readline
			temp13=textstr.readline
			temp14=textstr.readline
			temp15=textstr.readline
			temp16=textstr.readline
			temp17=textstr.readline
			temp18=textstr.readline
			temp19=textstr.readline
			temp20=textstr.readline
			temp21=textstr.readline
			temp22=textstr.readline
			temp23=textstr.readline
			temp24=textstr.readline
			temp25=textstr.readline
			temp26=textstr.readline
			temp27=textstr.readline
		end if
		TextStr.Close
		if HighScore=1 then
		
			Credits=cdbl(temp2)
			BallsPerGame=cdbl(temp3)
			ReplayLevel=cdbl(temp4)

			HSScore(1) = int(temp8)
			HSScore(2) = int(temp9)
			HSScore(3) = int(temp10)
			HSScore(4) = int(temp11)
			HSScore(5) = int(temp12)
			
			HSName(1) = temp13
			HSName(2) = temp14
			HSName(3) = temp15
			HSName(4) = temp16
			HSName(5) = temp17

			HSScore(6) = int(temp18)
			HSScore(7) = int(temp19)
			HSScore(8) = int(temp20)
			HSScore(9) = int(temp21)
			HSScore(10) = int(temp22)
			
			HSName(6) = temp23
			HSName(7) = temp24
			HSName(8) = temp25
			HSName(9) = temp26
			HSName(10) = temp27

		end if
		Set ScoreFile=Nothing
	    Set FileObj=Nothing
end sub

sub RefreshReplayCard
	Dim tempst1
	Dim tempst2
	
	tempst1=FormatNumber(BallsPerGame,0)
	tempst2=FormatNumber(ReplayLevel,0)

	Replay1=Replay1Table(ReplayLevel)
	Replay2=Replay2Table(ReplayLevel)
	Replay3=Replay3Table(ReplayLevel)
	Replay4=Replay4Table(ReplayLevel)
	InstructCard.image = "IC"
	ReplayCard.image = "SC"+ tempst1 + tempst2
end sub

' ============================================================================================
' GNMOD - Multiple High Score Display and Collection
' ============================================================================================
Dim EnteringInitials		' Normally zero, set to non-zero to enter initials
EnteringInitials = 0

Dim PlungerPulled
PlungerPulled = 0

Dim SelectedChar			' character under the "cursor" when entering initials

Dim HSTimerCount			' Pass counter for HS timer, scores are cycled by the timer
HSTimerCount = 5			' Timer is initially enabled, it'll wrap from 5 to 1 when it's displayed

Dim InitialString			' the string holding the player's initials as they're entered

Dim AlphaString				' A-Z, 0-9, space (_) and backspace (<)
Dim AlphaStringPos			' pointer to AlphaString, move forward and backward with flipper keys
AlphaString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_<"

Dim HSNewHigh				' The new score to be recorded

Dim HSScore(10)				' High Scores read in from config file
Dim HSName(10)				' High Score Initials read in from config file

' default high scores, remove this when the scores are available from the config file
HSScore(1) = 750000
HSScore(2) = 700000
HSScore(3) = 600000
HSScore(4) = 550000
HSScore(5) = 500000

HSName(1) = "AAA"
HSName(2) = "ZZZ"
HSName(3) = "XXX"
HSName(4) = "ABC"
HSName(5) = "BBB"

HSScore(6) = 750000
HSScore(7) = 700000
HSScore(8) = 600000
HSScore(9) = 550000
HSScore(10) = 500000

HSName(6) = "AAA"
HSName(7) = "ZZZ"
HSName(8) = "XXX"
HSName(9) = "ABC"
HSName(10) = "BBB"

Sub HighScoreTimer_Timer
	
	if EnteringInitials then
		if HSTimerCount = 1 then
			SetHSLine 3, InitialString & MID(AlphaString, AlphaStringPos, 1)
			HSTimerCount = 2
		else
			SetHSLine 3, InitialString
			HSTimerCount = 1
		end if
	elseif InProgress then
		SetHSLine 1, "HIGH SCORE1"
		SetHSLine 2, HSScore(1)
		SetHSLine 3, HSName(1)
		HSTimerCount = 5	' set so the highest score will show after the game is over
		HighScoreTimer.enabled=false
	elseif CheckAllScores then
		NewHighScore sortscores(ScoreChecker),sortplayers(ScoreChecker)

	else
		' cycle through high scores
		HighScoreTimer.interval=2000
		HSTimerCount = HSTimerCount + 1
		if HsTimerCount > 5 then
			HSTimerCount = 1
		End If
		SetHSLine 1, "HIGH SCORE"+FormatNumber(HSTimerCount,0)
		SetHSLine 2, HSScore(HSTimerCount)
		SetHSLine 3, HSName(HSTimerCount)
	end if
End Sub

Function GetHSChar(String, Index)
	dim ThisChar
	dim FileName
	ThisChar = Mid(String, Index, 1)
	FileName = "PostIt"
	if ThisChar = " " or ThisChar = "" then
		FileName = FileName & "BL"
	elseif ThisChar = "<" then
		FileName = FileName & "LT"
	elseif ThisChar = "_" then
		FileName = FileName & "SP"
	else
		FileName = FileName & ThisChar
	End If
	GetHSChar = FileName
End Function

Sub SetHsLine(LineNo, String)
	dim Letter
	dim ThisDigit
	dim ThisChar
	dim StrLen
	dim LetterLine
	dim Index
	dim StartHSArray
	dim EndHSArray
	dim LetterName
	dim xfor
	StartHSArray=array(0,1,12,22)
	EndHSArray=array(0,11,21,31)
	StrLen = len(string)
	Index = 1

	for xfor = StartHSArray(LineNo) to EndHSArray(LineNo)
		Eval("HS"&xfor).image = GetHSChar(String, Index)
		Index = Index + 1
	next

End Sub

Sub NewHighScore(NewScore, PlayNum)
	if NewScore > HSScore(5) then
		HighScoreTimer.interval = 500
		HSTimerCount = 1
		AlphaStringPos = 1		' start with first character "A"
		EnteringInitials = 1	' intercept the control keys while entering initials
		InitialString = ""		' initials entered so far, initialize to empty
		SetHSLine 1, "PLAYER "+FormatNumber(PlayNum,0)
		SetHSLine 2, "ENTER NAME"
		SetHSLine 3, MID(AlphaString, AlphaStringPos, 1)
		HSNewHigh = NewScore
		AddSpecial
	End if
	ScoreChecker=ScoreChecker-1
	if ScoreChecker=0 then
		CheckAllScores=0
	end if
End Sub

Sub CollectInitials(keycode)
	If keycode = LeftFlipperKey Then
		' back up to previous character
		AlphaStringPos = AlphaStringPos - 1
		if AlphaStringPos < 1 then
			AlphaStringPos = len(AlphaString)		' handle wrap from beginning to end
			if InitialString = "" then
				' Skip the backspace if there are no characters to backspace over
				AlphaStringPos = AlphaStringPos - 1
			End if
		end if
		SetHSLine 3, InitialString & MID(AlphaString, AlphaStringPos, 1)
		PlaySound "DropTargetDropped"
	elseif keycode = RightFlipperKey Then
		' advance to next character
		AlphaStringPos = AlphaStringPos + 1
		if AlphaStringPos > len(AlphaString) or (AlphaStringPos = len(AlphaString) and InitialString = "") then
			' Skip the backspace if there are no characters to backspace over
			AlphaStringPos = 1
		end if
		SetHSLine 3, InitialString & MID(AlphaString, AlphaStringPos, 1)
		PlaySound "DropTargetDropped"
	elseif keycode = StartGameKey or keycode = PlungerKey Then
		SelectedChar = MID(AlphaString, AlphaStringPos, 1)
		if SelectedChar = "_" then
			InitialString = InitialString & " "
			PlaySound("Ding10")
		elseif SelectedChar = "<" then
			InitialString = MID(InitialString, 1, len(InitialString) - 1)
			if len(InitialString) = 0 then
				' If there are no more characters to back over, don't leave the < displayed
				AlphaStringPos = 1
			end if
			PlaySound("Ding100")
		else
			InitialString = InitialString & SelectedChar
			PlaySound("Ding10")
		end if
		if len(InitialString) < 3 then
			SetHSLine 3, InitialString & SelectedChar
		End If
	End If
	if len(InitialString) = 3 then
		' save the score
		for i = 5 to 1 step -1
			if i = 1 or (HSNewHigh > HSScore(i) and HSNewHigh <= HSScore(i - 1)) then
				' Replace the score at this location
				if i < 5 then
' MsgBox("Moving " & i & " to " & (i + 1))
					HSScore(i + 1) = HSScore(i)
					HSName(i + 1) = HSName(i)
				end if
' MsgBox("Saving initials " & InitialString & " to position " & i)
				EnteringInitials = 0
				HSScore(i) = HSNewHigh
				HSName(i) = InitialString
				HSTimerCount = 5
				HighScoreTimer_Timer
				HighScoreTimer.interval = 2000
				PlaySound("Ding1000")
				exit sub
			elseif i < 5 then
				' move the score in this slot down by 1, it's been exceeded by the new score
' MsgBox("Moving " & i & " to " & (i + 1))
				HSScore(i + 1) = HSScore(i)
				HSName(i + 1) = HSName(i)
			end if
		next
	End If

End Sub
' END GNMOD
' ============================================================================================
' GNMOD - New Options menu
' ============================================================================================
Dim EnteringOptions
Dim CurrentOption
Dim OptionCHS
Dim MaxOption
Dim OptionHighScorePosition
Dim XOpt
Dim StartingArray
Dim EndingArray
Dim Replay1Table(15)
Dim Replay2Table(15)
Dim Replay3Table(15)
Dim Replay4Table(15)
Dim ReplayTableMax
Dim ReplayLevel

	Replay1Table(1)=360000
	Replay1Table(2)=440000
	Replay1Table(3)=51000
	Replay1Table(4)=62000
	Replay1Table(5)=4300
	Replay1Table(6)=4400
	Replay1Table(7)=4500
	Replay1Table(8)=4700
	Replay1Table(9)=4800
	Replay1Table(10)=4900
	Replay1Table(11)=5000
	Replay1Table(12)=5100
	Replay1Table(13)=5200
	Replay1Table(14)=5300
	Replay1Table(15)=999000

	Replay2Table(1)=520000
	Replay2Table(2)=580000
	Replay2Table(3)=73000
	Replay2Table(4)=85000
	Replay2Table(5)=5700
	Replay2Table(6)=5800
	Replay2Table(7)=5900
	Replay2Table(8)=6100
	Replay2Table(9)=6200
	Replay2Table(10)=6300
	Replay2Table(11)=6400
	Replay2Table(12)=6500
	Replay2Table(13)=6600
	Replay2Table(14)=6700
	Replay2Table(15)=999000

	Replay3Table(1)=9990000
	Replay3Table(2)=9990000
	Replay3Table(3)=87000
	Replay3Table(4)=999000
	Replay3Table(5)=6500
	Replay3Table(6)=6600
	Replay3Table(7)=6700
	Replay3Table(8)=6900
	Replay3Table(9)=7000
	Replay3Table(10)=7100
	Replay3Table(11)=7200
	Replay3Table(12)=7300
	Replay3Table(13)=7400
	Replay3Table(14)=7500
	Replay3Table(15)=999000

	Replay4Table(1)=9990000
	Replay4Table(2)=9990000
	Replay4Table(3)=9990000
	Replay4Table(4)=9990000
	Replay4Table(5)=9990000
	Replay4Table(6)=9990000
	Replay4Table(7)=9990000
	Replay4Table(8)=9990000
	Replay4Table(9)=9990000
	Replay4Table(10)=9990000
	Replay4Table(11)=9990000
	Replay4Table(12)=9990000
	Replay4Table(13)=9990000
	Replay4Table(14)=9990000
	Replay4Table(15)=9990000

	ReplayTableMax=2

StartingArray=Array(0,1,2,30,33,61,89,117,145,173,201,229)
EndingArray=Array(0,1,29,32,60,88,116,144,172,200,228,256)
EnteringOptions = 0
MaxOption = 9
OptionCHS = 0
OptionHighScorePosition = 0
Const OptionLinesToMark="111000011"
Const OptionLine1="" 'do not use this line
Const OptionLine2="" 'do not use this line
Const OptionLine3="" 'do not use this line
Const OptionLine4=""
Const OptionLine5=""
Const OptionLine6=""
Const OptionLine7=""
Const OptionLine8="" 'do not use this line
Const OptionLine9="" 'do not use this line

Sub OperatorMenuTimer_Timer
	EnteringOptions = 1
	OperatorMenuTimer.enabled=false
	ShowOperatorMenu
end sub

sub ShowOperatorMenu
	OperatorMenuBackdrop.image = "OperatorMenu"

	OptionCHS = 0
	CurrentOption = 1
	DisplayAllOptions
	OperatorOption1.image = "BluePlus"
	SetHighScoreOption

End Sub

Sub DisplayAllOptions
	dim linecounter
	dim tempstring
	dim TempText1
	dim TempText2
	dim TempText3
	For linecounter = 1 to MaxOption
		tempstring=Eval("OptionLine"&linecounter)
		Select Case linecounter
			Case 1:
				tempstring=tempstring + FormatNumber(BallsPerGame,0)
				SetOptLine 1,tempstring
			Case 2:
				if Replay3Table(ReplayLevel)=9990000 then
					tempstring = FormatNumber(Replay1Table(ReplayLevel),0) + "/" + FormatNumber(Replay2Table(ReplayLevel),0)
				elseif Replay4Table(ReplayLevel)=9990000 then
					tempstring = FormatNumber(Replay1Table(ReplayLevel),0) + "/" + FormatNumber(Replay2Table(ReplayLevel),0) + "/" + FormatNumber(Replay3Table(ReplayLevel),0)
				else
					tempstring = FormatNumber(Replay1Table(ReplayLevel),0) + "/" + FormatNumber(Replay2Table(ReplayLevel),0) + "/" + FormatNumber(Replay3Table(ReplayLevel),0) + "/" + FormatNumber(Replay4Table(ReplayLevel),0)
				end if
				SetOptLine 2,tempstring
			Case 3:
				If OptionCHS=0 then
					tempstring = "NO"
				else
					tempstring = "YES"
				end if
				SetOptLine 3,tempstring
			Case 4:
				SetOptLine 4, tempstring
	

				SetOptLine 5, tempstring
			Case 5:
				SetOptLine 6, tempstring
				
				SetOptLine 7, tempstring

			Case 6:
				SetOptLine 8, tempstring

				SetOptLine 9, tempstring
				
			Case 7:
				SetOptLine 10, tempstring
				SetOptLine 11, tempstring
			
			Case 8:
		
			Case 9:
			
	
		End Select
		
	next
end sub

sub MoveArrow
	do 
		CurrentOption = CurrentOption + 1
		If CurrentOption>Len(OptionLinesToMark) then
			CurrentOption=1
		end if
	loop until Mid(OptionLinesToMark,CurrentOption,1)="1"
end sub

sub CollectOptions(ByVal keycode)
	if Keycode = LeftFlipperKey then
		PlaySound "DropTargetDropped"
		For XOpt = 1 to MaxOption
			Eval("OperatorOption"&XOpt).image = "PostitBL"
		next
		MoveArrow
		if CurrentOption<8 then
			Eval("OperatorOption"&CurrentOption).image = "BluePlus"
		elseif CurrentOption=8 then
			Eval("OperatorOption"&CurrentOption).image = "GreenCheck"
		else
			Eval("OperatorOption"&CurrentOption).image = "RedX"
		end if
			
	elseif Keycode = RightFlipperKey then
		PlaySound "DropTargetDropped"
		if CurrentOption = 1 then
			If BallsPerGame = 3 then
				BallsPerGame = 5
			else
				BallsPerGame = 3
			end if
			DisplayAllOptions
		elseif CurrentOption = 2 then
			ReplayLevel=ReplayLevel+1
			If ReplayLevel>ReplayTableMax then
				ReplayLevel=1
			end if
			DisplayAllOptions
		elseif CurrentOption = 3 then
			if OptionCHS = 0 then
				OptionCHS = 1
				
			else
				OptionCHS = 0
				
			end if
			DisplayAllOptions


		elseif CurrentOption = 8 or CurrentOption = 9 then
				if OptionCHS=1 then
					HSScore(1) = 750000	
					HSScore(2) = 700000
					HSScore(3) = 600000
					HSScore(4) = 550000
					HSScore(5) = 500000

					HSName(1) = "AAA"
					HSName(2) = "ZZZ"
					HSName(3) = "XXX"
					HSName(4) = "ABC"
					HSName(5) = "BBB"


					HSScore(6) = 750000
					HSScore(7) = 700000
					HSScore(8) = 600000
					HSScore(9) = 550000
					HSScore(10) = 500000
					
					HSName(6) = "AAA"
					HSName(7) = "ZZZ"
					HSName(8) = "XXX"
					HSName(9) = "ABC"
					HSName(10) = "BBB"
				end if
	
				if CurrentOption = 8 then
					savehs
				else
					loadhs
				end if
				OperatorMenuBackdrop.image = "PostitBL"
				For XOpt = 1 to MaxOption
					Eval("OperatorOption"&XOpt).image = "PostitBL"
				next
			
				For XOpt = 1 to 256
					Eval("Option"&XOpt).image = "PostItBL"
				next
				RefreshReplayCard

				EnteringOptions = 0

		end if
	end if
End Sub

Sub SetHighScoreOption
	
End Sub

Function GetOptChar(String, Index)
	dim ThisChar
	dim FileName
	ThisChar = Mid(String, Index, 1)
	FileName = "PostIt"
	if ThisChar = " " or ThisChar = "" then
		FileName = FileName & "BL"
	elseif ThisChar = "<" then
		FileName = FileName & "LT"
	elseif ThisChar = "_" then
		FileName = FileName & "SP"
	elseif ThisChar = "/" then
		FileName = FileName & "SL"
	elseif ThisChar = "," then
		FileName = FileName & "CM"
	else
		FileName = FileName & ThisChar
	End If
	GetOptChar = FileName
End Function

dim LineLengths(22)	' maximum number of lines
Sub SetOptLine(LineNo, String)
	Dim DispLen
    Dim StrLen
	dim xfor
	dim Letter
	dim ThisDigit
	dim ThisChar
	dim LetterLine
	dim Index
	dim LetterName
	StrLen = len(string)
	Index = 1

	StrLen = len(String)
    DispLen = StrLen
    if (DispLen < LineLengths(LineNo)) Then
        DispLen = LineLengths(LineNo)
    end If

	for xfor = StartingArray(LineNo) to StartingArray(LineNo) + DispLen
		Eval("Option"&xfor).image = GetOptChar(string, Index)
		Index = Index + 1
	next
	LineLengths(LineNo) = StrLen

End Sub

